home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0057_UUENCODE.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-21  |  4KB  |  164 lines
  1. {
  2. From: BOB SWART
  3. Subj: UUENCODE.PAS
  4. Here is my version of UUENCODE.PAS (fully compatible):
  5. }
  6.  
  7. {$IFDEF VER70}
  8. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}
  9. {$ELSE}
  10. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}
  11. {$ENDIF}
  12. {$M 8192,0,0}
  13. {
  14.   UUEnCode 3.0
  15.   Borland Pascal (Objects) 7.0.
  16.   Copr. (c) 9-29-1993 DwarFools & Consultancy drs. Robert E. Swart
  17.                       P.O. box 799
  18.                       5702 NP  Helmond
  19.                       The Netherlands
  20.   Code size: 4880 bytes
  21.   Data size: 1122 bytes
  22.   .EXE size: 3441 bytes
  23.   ----------------------------------------------------------------
  24.   This program uuencodes files.
  25. }
  26.  
  27. Const
  28.   SP = Byte(' ');
  29.  
  30. Type
  31.   TTriplet = Array[0..2] of Byte;
  32.   TKwartet = Array[0..3] of Byte;
  33.  
  34. var Triplets: Array[1..15] of TTriplet;
  35.     kwar: TKwartet;
  36.     FileName: String[12];
  37.     i,j: Integer;
  38.     f: File;
  39.     g: Text;
  40.  
  41.  
  42.     FUNCTION UpperStr(S : STRING) : STRING;
  43.     VAR sLen : BYTE ABSOLUTE S;
  44.         I    : BYTE;
  45.     BEGIN
  46.     FOR I := 1 TO sLEN DO S := UpCase(S[i]);
  47.     UpperStr := S;
  48.     END;
  49.  
  50.     procedure Triplet2Kwartet(Triplet: TTriplet; var Kwartet: TKwartet);
  51.     var i: Integer;
  52.     begin
  53.       Kwartet[0] := (Triplet[0] SHR 2);
  54.       Kwartet[1] := ((Triplet[0] SHL 4) AND $30) +
  55.                     ((Triplet[1] SHR 4) AND $0F);
  56.       Kwartet[2] := ((Triplet[1] SHL 2) AND $3C) +
  57.                     ((Triplet[2] SHR 6) AND $03);
  58.       Kwartet[3] := (Triplet[2] AND $3F);
  59.       for i:=0 to 3 do
  60.       begin
  61.         if Kwartet[i] = 0 then Kwartet[i] := $40;
  62.         Inc(Kwartet[i],SP)
  63.       end
  64.     end {Triplet2Kwartet};
  65.  
  66.  
  67. begin
  68.   writeln('UUEnCode 3.0 (c) 1993 DwarFools & Consultancy' +
  69.                               ', by drs. Robert E. Swart'#13#10);
  70.   if ParamCount = 0 then
  71.   begin
  72.     writeln('Usage: UUEnCode infile [outfile]');
  73.     Halt
  74.   end;
  75.   if UpperStr(ParamStr(1)) = UpperStr(ParamStr(2)) then
  76.   begin
  77.     writeln('Error: infile = outfile');
  78.     Halt(1)
  79.   end;
  80.  
  81.   Assign(f,ParamStr(1));
  82.   FileMode := $40;
  83.   reset(f,1);
  84.   if IOResult <> 0 then
  85.   begin
  86.     writeln('Error: could not open file ',ParamStr(1));
  87.     Halt(2)
  88.   end;
  89.  
  90.   if ParamCount <> 2 then
  91.   begin
  92.     FileName := ParamStr(1);
  93.     i := Pos('.',FileName);
  94.     if i > 0 then Delete(FileName,i,Length(FileName));
  95.     FileName := FileName + '.UUE'
  96.   end
  97.   else FileName := ParamStr(2);
  98.  
  99.   if UpperStr(ParamStr(1)) = UpperStr(FileName) then
  100.   begin
  101.     writeln('Error: input file = output file');
  102.     Halt(1)
  103.   end;
  104.  
  105.   Assign(g,FileName);
  106.   if ParamCount > 1 then
  107.   begin
  108.     FileMode := $02;
  109.     reset(g);
  110.     if IOResult = 0 then
  111.     begin
  112.       writeln('Error: file ',FileName,' already exists.');
  113.       halt(3)
  114.     end
  115.   end;
  116.   rewrite(g);
  117.   if IOResult <> 0 then
  118.   begin
  119.     writeln('Error: could not create file ',FileName);
  120.     Halt(4)
  121.   end;
  122.  
  123.   writeln(g,'begin 0777 ',ParamStr(1));
  124.   repeat
  125.     FillChar(Triplets,SizeOf(Triplets),#0);
  126.     BlockRead(f,Triplets,SizeOf(Triplets),i);
  127.     write(g,Char(SP+i));
  128.     for j:=1 to (i+2) div 3 do
  129.     begin
  130.       Triplet2Kwartet(Triplets[j],kwar);
  131.       write(g,Char(kwar[0]),Char(kwar[1]),Char(kwar[2]),Char(kwar[3]))
  132.     end;
  133.     writeln(g)
  134.   until (i < SizeOf(Triplets));
  135.   writeln(g,'end');
  136.   close(f);
  137.   close(g);
  138.  
  139.   if ParamCount > 1 then
  140.     writeln('UUEnCoded file ',FileName,' created.');
  141.   writeln
  142. end.
  143.  
  144.  
  145.  
  146. The basic scheme is to break groups of 3 eight bit characters (24 bits) into 4
  147. six bit characters and then add 32 (a space) to each six bit character which
  148. maps it into the readily transmittable character.  Another way of phrasing this
  149. is to say that the encoded 6 bit characters are mapped into the set:
  150.  
  151.        !"#$%&'()*+,-./012356789:;<=>?@ABC...XYZ[\]^_
  152.  
  153. for transmission over communications lines.
  154.  
  155. As some transmission mechanisms compress or remove spaces, spaces are changed
  156. into back-quote characters (a 96).  (A better scheme might be to use a bias of
  157. 33 so the space is not created, but this is not done.)
  158.  
  159. The advantage of this over just hex encoding is that it put in 6 bits of signal
  160. per byte, instead of just 4.  The target is to get the smallest uncompressed
  161. size, since the assumption is that you've already compressed as much redundancy
  162. as possible out of the original.
  163.  
  164.